<%
Class FastAsp_Validate
    Private m_Rules      '验证规则
    Private m_Messages   '错误信息
    Private m_Errors     '验证错误
    Private m_Data       '待验证数据
    
    Private Sub Class_Initialize()
        Set m_Rules = Server.CreateObject("Scripting.Dictionary")
        Set m_Messages = Server.CreateObject("Scripting.Dictionary")
        Set m_Errors = Server.CreateObject("Scripting.Dictionary")
    End Sub
    
    '设置验证规则
    Public Function Rule(byval field, byval ruleStr)
        m_Rules.Add field, ruleStr
        Set Rule = Me
    End Function
    
    '设置错误信息
    Public Function Message(byval field, byval msgText)
        m_Messages.Add field, msgText
        Set Message = Me
    End Function
    
    '验证数据
    Public Function Check(byval data)
        Set m_Data = data
        m_Errors.RemoveAll
        
        Dim field, rules, rule, value
        For Each field In m_Rules.Keys
            rules = Split(m_Rules(field), "|")
            If TypeName(data) = "Dictionary" Then
                value = data(field)
            Else
                value = Eval("data." & field)
            End If
            
            For Each rule In rules
                If Not ValidateRule(field, value, rule) Then Exit For
            Next
        Next
        
        Check = (m_Errors.Count = 0)
    End Function
    
    '获取错误信息
    Public Function GetErrors()
        Set GetErrors = m_Errors
    End Function
    
    '验证规则
    Private Function ValidateRule(byval field, byval value, byval ruleStr)
        Dim parts : parts = Split(ruleStr, ":")
        Dim ruleName : ruleName = parts(0)
        Dim param : param = ""
        If UBound(parts) > 0 Then param = parts(1)
        
        Select Case LCase(ruleName)
            Case "required"
                If IsEmpty(value) Or IsNull(value) Or value = "" Then
                    AddError field, "required", "不能为空"
                    ValidateRule = False
                    Exit Function
                End If
                
            Case "email"
                If Not IsNull(value) And value <> "" Then
                    If Not RegExpTest("^[\w\.-]+@[\w\.-]+\.\w+$", value) Then
                        AddError field, "email", "邮箱格式不正确"
                        ValidateRule = False
                        Exit Function
                    End If
                End If
                
            Case "url"
                If Not IsNull(value) And value <> "" Then
                    If Not RegExpTest("^https?://[\w\.-]+\.\w+", value) Then
                        AddError field, "url", "URL格式不正确"
                        ValidateRule = False
                        Exit Function
                    End If
                End If
                
            Case "number"
                If Not IsNull(value) And value <> "" Then
                    If Not IsNumeric(value) Then
                        AddError field, "number", "必须是数字"
                        ValidateRule = False
                        Exit Function
                    End If
                End If
                
            Case "min"
                If Not IsNull(value) And value <> "" Then
                    If CDbl(value) < CDbl(param) Then
                        AddError field, "min", "不能小于" & param
                        ValidateRule = False
                        Exit Function
                    End If
                End If
                
            Case "max"
                If Not IsNull(value) And value <> "" Then
                    If CDbl(value) > CDbl(param) Then
                        AddError field, "max", "不能大于" & param
                        ValidateRule = False
                        Exit Function
                    End If
                End If
                
            Case "length"
                If Not IsNull(value) And value <> "" Then
                    If Len(value) <> CLng(param) Then
                        AddError field, "length", "长度必须为" & param & "位"
                        ValidateRule = False
                        Exit Function
                    End If
                End If
                
            Case "minlength"
                If Not IsNull(value) And value <> "" Then
                    If Len(value) < CLng(param) Then
                        AddError field, "minlength", "长度不能小于" & param & "位"
                        ValidateRule = False
                        Exit Function
                    End If
                End If
                
            Case "maxlength"
                If Not IsNull(value) And value <> "" Then
                    If Len(value) > CLng(param) Then
                        AddError field, "maxlength", "长度不能大于" & param & "位"
                        ValidateRule = False
                        Exit Function
                    End If
                End If
                
            Case "regex"
                If Not IsNull(value) And value <> "" Then
                    If Not RegExpTest(param, value) Then
                        AddError field, "regex", "格式不正确"
                        ValidateRule = False
                        Exit Function
                    End If
                End If
        End Select
        
        ValidateRule = True
    End Function
    
    '添加错误信息
    Private Sub AddError(byval field, byval ruleName, byval defaultMsg)
        Dim msg
        If m_Messages.Exists(field & "." & ruleName) Then
            msg = m_Messages(field & "." & ruleName)
        ElseIf m_Messages.Exists(field) Then
            msg = m_Messages(field)
        Else
            msg = field & defaultMsg
        End If
        m_Errors.Add field, msg
    End Sub
    
    '正则表达式测试
    Private Function RegExpTest(byval pattern, byval str)
        Dim reg : Set reg = New RegExp
        reg.Pattern = pattern
        reg.Global = True
        reg.IgnoreCase = True
        RegExpTest = reg.Test(str)
        Set reg = Nothing
    End Function
    
    Private Sub Class_Terminate()
        Set m_Rules = Nothing
        Set m_Messages = Nothing
        Set m_Errors = Nothing
        Set m_Data = Nothing
    End Sub
End Class
%> 